perm filename LIBHED.SAI[X,AIL] blob sn#053545 filedate 1973-08-19 generic text, type T, neo UTF8
COMMENT ⊗   VALID 00002 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00002 00002	BEGIN "LIBHED"
 00004 ENDMK
⊗;
BEGIN "LIBHED"
INTEGER COUNT,TYPEWD,BLKSIZ,BRK,EOF; DEFINE SRC=1, DST=2; 
INTEGER ARRAY BLOCK[0:17];

PROCEDURE GETBLK;
BEGIN "GETBLK"
    IF COUNT=0 THEN BEGIN
	TYPEWD ← WORDIN(SRC);
	COUNT ← TYPEWD LAND '777777;
	TYPEWD ← TYPEWD LSH -18
    END;
    WORDIN(SRC);
    ARRYIN(SRC,BLOCK[0],BLKSIZ ← COUNT MIN 18);
    COUNT ← COUNT - BLKSIZ
END "GETBLK";

PROCEDURE PUTBLK(INTEGER TYPE, VAL1, VAL2);
BEGIN "PUTBLK"
    INTEGER CT;
    WORDOUT(DST,TYPE LSH 18 + (CT←CASE TYPE OF (0,0,2,0,1,1,2)));
    WORDOUT(DST,IF TYPE=5 THEN '2 LSH 33 ELSE 0);
    WORDOUT(DST,VAL1);
    IF CT=2 THEN WORDOUT(DST,VAL2);
END "PUTBLK";

OPEN(SRC,"DSK",'10,2,0,0,BRK,EOF);
OPEN(DST,"DSK",'10,0,2,0,COUNT,COUNT);
LOOKUP(SRC,"HEAD.REL",COUNT);
ENTER(DST,"HEAD.LIB",COUNT);

COUNT←0;
DO GETBLK UNTIL TYPEWD=2;
DO BEGIN
    INTEGER B,C;
    C←BLOCK[0];
    IF (LDB(POINT(6,C,5)) LAND '74) = '44 THEN BEGIN
	PUTBLK(4,B←C LAND '37777777777,0);
	PUTBLK(6,B,0);
	PUTBLK(2,C,BLOCK[1]);
	PUTBLK(5,0,0);
    END;
    GETBLK
END UNTIL TYPEWD=5;

COMMENT AS FUDGE2 DOES NOT COPY THE LAST ELEMENT WE MUST PROVIDE A DUMMY;
PUTBLK(4,'77,0);
PUTBLK(6,'77,0);
PUTBLK(2,'100000000077,0);
PUTBLK(5,0,0);

RELEASE(SRC); RELEASE(DST)
END "LIBHED";